home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / axpicker / axbutton.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  1999-05-09  |  47.4 KB  |  1,219 lines

  1. VERSION 5.00
  2. Begin VB.UserControl axPickerButton 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   615
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   2115
  8.    DefaultCancel   =   -1  'True
  9.    ScaleHeight     =   41
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   141
  12. End
  13. Attribute VB_Name = "axPickerButton"
  14. Attribute VB_GlobalNameSpace = False
  15. Attribute VB_Creatable = True
  16. Attribute VB_PredeclaredId = False
  17. Attribute VB_Exposed = False
  18. Option Explicit
  19. 'Default Property Values:
  20. Const m_def_Style = 0
  21. Const m_def_DropDown = False
  22. Const m_def_MaskColor = vbButtonFace
  23. Const m_def_PictureAlign = 2
  24. Const m_def_Caption = ""
  25. Const m_def_ButtonGroup = ""
  26. Const m_def_ButtonGroupDefault = False
  27. Const m_def_ButtonGroupDefault2 = False
  28.  
  29. 'Enums
  30. Enum envbuPictureAlign
  31.     vbPicLeft = 0
  32.     vbPicRight = 1
  33.     vbPicTop = 2
  34.     vbPicBottom = 3
  35. End Enum
  36.  
  37. 'kdq 10/19/98 added new styles
  38. Enum vbuStyle
  39.     [Cool Button] = 0
  40.     [Toolbar Button] = 1
  41.     [Seperator] = 2
  42.     [SeperatorH] = 3
  43.     [Toolbar Handle] = 4
  44.     [Toolbar HandleH] = 5
  45.     [Standard Button] = 6
  46.     [Up-Down Button] = 7
  47. End Enum
  48.  
  49. 'Property Variables:
  50. Dim HaveCapture As Boolean
  51. Dim PaintedUp As Boolean
  52. Dim m_Style As vbuStyle
  53. Dim m_DropDown As Boolean
  54. Dim m_MaskColor As OLE_COLOR
  55. Dim m_Picture As Picture
  56. Dim m_PictureAlign As envbuPictureAlign
  57. Dim m_Caption As String
  58. Dim m_Value As Boolean
  59. Dim m_ButtonGroupDefault As Boolean
  60. Dim m_ButtonGroupDefault2 As Boolean
  61. Dim m_ButtonGroup As String
  62. Private hUpDownDitherBrush As Long
  63. Private UpDownButtonFace As Long
  64.  
  65. 'Event Declarations:
  66. Event MouseEnter()
  67. Attribute MouseEnter.VB_Description = "Fires when the mouse cursor enters the boundaries of the control."
  68. Event MouseExit()
  69. Attribute MouseExit.VB_Description = "Fires when the mouse leaves the boundaries of the control."
  70. Event DropDownClick()
  71. Attribute DropDownClick.VB_Description = "Fires whenever the Drop Down Button is Clicked."
  72. Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
  73. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  74. Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
  75. Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
  76. Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
  77. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
  78. Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
  79. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  80. Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
  81. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
  82. Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
  83. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  84. Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
  85. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  86. Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
  87. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  88.  
  89. Private mbButtonDown As Boolean
  90. Private mbMouseDown As Boolean
  91. Private miXOffset As Integer
  92. Private miYOffset As Integer
  93. Private mbHasFocus As Boolean
  94. Private mbMouseOver As Boolean
  95. Private mbDropDownPressed As Boolean
  96. Private miCurrentButtonPressed As Integer
  97. Private WithEvents ExitTimer As objTimer
  98. Attribute ExitTimer.VB_VarHelpID = -1
  99.  
  100. Private miClientWidth As Integer
  101. Private miClientHeight As Integer
  102. Private miClientTop As Integer
  103. Private miClientLeft As Integer
  104. Private m_ButtonFace As OLE_COLOR, m_ButtonLightShadow As OLE_COLOR
  105. Private m_ButtonDarkShadow As OLE_COLOR, m_ButtonHighlight As OLE_COLOR
  106. Private m_DownPicture As Picture
  107. Private m_FlatPicture As Picture, m_ShowFlatGrey As Boolean
  108.  
  109. Private Sub Leave()
  110.     mbMouseOver = False
  111.     
  112.     Set ExitTimer = Nothing
  113.     DrawButton
  114.     
  115.     RaiseEvent MouseExit
  116. End Sub
  117.  
  118. Private Function UnderMouse() As Boolean
  119.     Dim ptMouse As POINTAPI
  120.  
  121.     GetCursorPos ptMouse
  122.     If WindowFromPoint(ptMouse.x, ptMouse.y) = UserControl.hWnd Then
  123.         UnderMouse = True
  124.     Else
  125.         UnderMouse = False
  126.     End If
  127.  
  128. End Function
  129.  
  130. Private Sub DrawButton()
  131.     Dim iWidth As Integer
  132.     Dim iHeight As Integer
  133.     Dim iTextWidth As Integer, iTextHeight As Integer, iTextTop As Integer, iTextLeft As Integer
  134.     Dim iPicWidth As Integer, iPicHeight As Integer, iPicTop As Integer, iPicLeft As Integer
  135.     Dim iFocusOffset As Integer
  136.     Dim clsPaint As New PaintEffects
  137.     Dim iDownOffset As Integer
  138.     Dim udtRect As RECT
  139.     Dim udtTextRect As RECT
  140.     Dim lReturn As Long
  141.     Dim lArrowTop As Long
  142.     Dim lArrowLeft As Long
  143.     Dim picButton As Picture
  144.     Dim ret As Integer
  145.     
  146.     UserControl.Cls
  147.     If m_DropDown Then
  148.         iWidth = UserControl.ScaleWidth - 10
  149.         iHeight = UserControl.ScaleHeight
  150.     Else
  151.         iWidth = UserControl.ScaleWidth
  152.         iHeight = UserControl.ScaleHeight
  153.     End If
  154.     
  155.     'These client variable describe the area
  156.     'inside the button to draw the picture.
  157.     'You can think of these like page margins
  158.     'in a word processor
  159.     miClientWidth = iWidth - 6
  160.     miClientHeight = iHeight - 8
  161.     miClientTop = 3
  162.     miClientLeft = 3
  163.     
  164.     'If (mbHasFocus Or UserControl.Ambient.DisplayAsDefault) And m_Style = [Standard Button] Then
  165.     If mbHasFocus And m_Style = [Standard Button] Then
  166.         iFocusOffset = 1
  167.         UserControl.Line (0, 0)-(UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1), vb3DDKShadow, B
  168.     Else
  169.         iFocusOffset = 0
  170.     End If
  171.     
  172.     udtRect.Top = iFocusOffset
  173.     udtRect.Left = iFocusOffset
  174.     udtRect.Right = iWidth - iFocusOffset - IIf(iFocusOffset = 1, 1, 0)
  175.     udtRect.Bottom = iHeight - iFocusOffset - IIf(iFocusOffset = 1, 1, 0)
  176.     
  177.     'kdq 10/19/98 added DrawShadowBox for new styles of buttons. Coolbutton should
  178.     'have thinner border than a regular button
  179.     Select Case m_Style
  180.     Case [Cool Button]
  181.         If mbMouseOver Or miCurrentButtonPressed > -1 Then
  182.             If mbButtonDown Then
  183.                 'Draw Button Down State
  184.                 DrawShadowBox udtRect, True, False
  185.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  186.                 iDownOffset = 1
  187.             Else
  188.                 'Draw Button Up State
  189.                 DrawShadowBox udtRect, False, False
  190.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  191.                 iDownOffset = 0
  192.             End If
  193.         End If
  194.  
  195.     Case [Toolbar Button]
  196.         If mbButtonDown Then
  197.             'Draw Button Down State
  198.             DrawShadowBox udtRect, True, False
  199.             'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  200.             iDownOffset = 1
  201.         Else
  202.             'Draw Button Up State
  203.             DrawShadowBox udtRect, False, False
  204.             'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  205.             iDownOffset = 0
  206.         End If
  207.     
  208.     Case [Standard Button]
  209.         If mbButtonDown Then
  210.             'Draw Button Down State
  211.             DrawShadowBox udtRect, True, True
  212.             'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  213.             iDownOffset = 1
  214.         Else
  215.             'Draw Button Up State
  216.             DrawShadowBox udtRect, False, True
  217.             'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  218.             iDownOffset = 0
  219.         End If
  220.     
  221.     Case [Seperator]
  222.         Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
  223.         DrawVLine ScaleWidth \ 2 - 1, 0, 2, ScaleHeight
  224.     
  225.     Case [SeperatorH]
  226.         Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
  227.         DrawHLine 0, ScaleHeight \ 2 - 1, ScaleWidth, 2
  228.     
  229.     Case [Toolbar Handle]
  230.         Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
  231.         DrawRaisedVLine ScaleWidth \ 2 - 4, 0, 3, ScaleHeight
  232.         DrawRaisedVLine ScaleWidth \ 2, 0, 3, ScaleHeight
  233.     
  234.     Case [Toolbar HandleH]
  235.         Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
  236.         DrawRaisedHLine 0, ScaleHeight \ 2 - 4, ScaleWidth, 3
  237.         DrawRaisedHLine 0, ScaleHeight \ 2, ScaleWidth, 3
  238.     
  239.     Case [Up-Down Button]
  240.         If m_Value Then
  241.           If mbMouseOver Then
  242.             PaintUpDownDither 1, 1, ScaleWidth - 2, ScaleHeight - 2
  243.             DrawShadowBox udtRect, True, False
  244.           Else
  245.             DrawShadowBox udtRect, True, False
  246.           End If
  247.         Else
  248.           If mbMouseOver Or miCurrentButtonPressed > -1 Then
  249.             If mbButtonDown Then
  250.                 'Draw Button Down State
  251.                 DrawShadowBox udtRect, True, False
  252.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  253.                 iDownOffset = 1
  254.             Else
  255.                 'Draw Button Up State
  256.                 DrawShadowBox udtRect, False, False
  257.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  258.                 iDownOffset = 0
  259.             End If
  260.           End If
  261.         End If
  262.     
  263.     End Select
  264.     
  265.     'Draw the DropDown button
  266.     If m_DropDown Then
  267.         udtRect.Top = iFocusOffset
  268.         udtRect.Left = iWidth '- iFocusOffset
  269.         udtRect.Right = 10 - iFocusOffset
  270.         udtRect.Bottom = iHeight - iFocusOffset - IIf(iFocusOffset = 1, 1, 0)
  271.         Select Case m_Style
  272.         Case [Cool Button]   'Soft Button
  273.             If mbMouseOver Or miCurrentButtonPressed > -1 Then
  274.                 If mbDropDownPressed Then
  275.                     'Draw Button Down State
  276.                     DrawShadowBox udtRect, True, False
  277.                     'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  278.                     iDownOffset = 0
  279.                 Else
  280.                     'Draw Button Up State
  281.                     DrawShadowBox udtRect, False, False
  282.                     'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  283.                 End If
  284.             End If
  285.         Case [Toolbar Button], [Standard Button]       'toolbar, standard
  286.             If mbDropDownPressed Then
  287.                 'Draw Button Down State
  288.                 DrawShadowBox udtRect, True, True
  289.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  290.                 iDownOffset = 0
  291.             Else
  292.                 'Draw Button Up State
  293.                 DrawShadowBox udtRect, False, True
  294.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  295.             End If
  296.         End Select
  297.     End If
  298.  
  299.     'Draw the Dropdown arrow
  300.     If m_DropDown And (m_Style = [Cool Button] Or m_Style = [Toolbar Button] Or m_Style = [Standard Button]) Then
  301.         lArrowTop = (UserControl.ScaleHeight / 2) '- 2
  302.         lArrowLeft = iWidth + 1 - iFocusOffset
  303.         UserControl.Line ((lArrowLeft) + 1, lArrowTop)-((lArrowLeft) + 6, lArrowTop), vbBlack
  304.         UserControl.Line ((lArrowLeft) + 2, lArrowTop + 1)-((lArrowLeft) + 5, lArrowTop + 1), vbBlack
  305.         UserControl.Line ((lArrowLeft) + 3, lArrowTop + 2)-((lArrowLeft) + 4, lArrowTop + 2), vbBlack
  306.     End If
  307.     'Draw The Button Face
  308.  
  309.     'Get the Caption Width and Height
  310.     iTextWidth = UserControl.TextWidth(m_Caption)
  311.     iTextHeight = UserControl.TextHeight(m_Caption)
  312.  
  313.     'kdq 10/19/98
  314.     'figure out which picture to display
  315.     If mbMouseOver And mbMouseDown And Not m_DownPicture Is Nothing And m_Style = [Cool Button] Then
  316.       Set picButton = m_DownPicture
  317.     ElseIf Not mbMouseOver And Not m_FlatPicture Is Nothing And m_Style = [Cool Button] Then
  318.       Set picButton = m_FlatPicture
  319.     Else
  320.       Set picButton = m_Picture
  321.     End If
  322.     
  323.     If Not picButton Is Nothing And m_Caption > "" Then
  324.         'Get the Pictures Width and Height
  325.         iPicWidth = ScaleX(picButton.Width, vbHimetric, vbPixels)
  326.         iPicHeight = ScaleY(picButton.Height, vbHimetric, vbPixels)
  327.  
  328.         'Set locations for the Picture and the Caption
  329.         Select Case m_PictureAlign
  330.         Case vbPicLeft
  331.             iPicLeft = miClientLeft
  332.             iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
  333.             udtTextRect.Top = miClientTop
  334.             udtTextRect.Bottom = miClientTop + miClientHeight
  335.             udtTextRect.Left = miClientLeft + iPicWidth
  336.             udtTextRect.Right = miClientLeft + miClientWidth
  337.         Case vbPicRight
  338.             iPicLeft = miClientLeft + miClientWidth - iPicWidth
  339.             iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
  340.             udtTextRect.Top = miClientTop
  341.             udtTextRect.Bottom = miClientTop + miClientHeight
  342.             udtTextRect.Left = miClientLeft ' + iPicWidth
  343.             udtTextRect.Right = miClientLeft + miClientWidth - iPicWidth
  344.         Case vbPicTop
  345.             iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2) + 1
  346.             iPicTop = miClientTop
  347.             udtTextRect.Top = miClientTop + iPicHeight + iPicTop
  348.             udtTextRect.Bottom = miClientTop + miClientHeight
  349.             udtTextRect.Left = miClientLeft
  350.             udtTextRect.Right = miClientLeft + miClientWidth
  351.         Case vbPicBottom
  352.             iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2) + 1
  353.             iPicTop = miClientTop + miClientHeight - iPicHeight
  354.             udtTextRect.Top = miClientTop
  355.             udtTextRect.Bottom = miClientTop + miClientHeight - iPicHeight
  356.             udtTextRect.Left = miClientLeft
  357.             udtTextRect.Right = miClientLeft + miClientWidth
  358.         End Select
  359.     'kdq 10/19/98 center picture if no caption
  360.     ElseIf Not picButton Is Nothing And m_Caption = "" Then
  361.             'Get the Pictures Width and Height
  362.             iPicWidth = ScaleX(picButton.Width, vbHimetric, vbPixels)
  363.             iPicHeight = ScaleY(picButton.Height, vbHimetric, vbPixels)
  364.             iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2)
  365.             iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
  366.             udtTextRect.Top = miClientTop
  367.             udtTextRect.Bottom = miClientTop + miClientHeight
  368.             udtTextRect.Left = miClientLeft
  369.             udtTextRect.Right = miClientLeft + miClientWidth
  370.     'kdq 10/19/98 center caption if not picture
  371.     ElseIf picButton Is Nothing And m_Caption > "" Then
  372.             udtTextRect.Top = miClientTop
  373.             udtTextRect.Bottom = miClientTop + miClientHeight
  374.             udtTextRect.Left = miClientLeft
  375.             udtTextRect.Right = miClientLeft + miClientWidth
  376.     End If
  377.  
  378.     '10/19/98 kdq the rect values were changed so Standard buttom displays correctly when it has focus
  379.     'Draw The Dotted Focus lines, but not for the soft button
  380.     If m_Style = [Standard Button] Then
  381.         If mbHasFocus Then
  382.             udtRect.Top = udtTextRect.Top    'iTextTop - 1
  383.             udtRect.Left = udtTextRect.Left + 1 'iTextLeft - 1
  384.             udtRect.Right = udtTextRect.Right - 1 'iTextLeft + iTextWidth + 1
  385.             udtRect.Bottom = udtTextRect.Bottom + 1 'iTextTop + iTextHeight + 1
  386.             lReturn = DrawFocusRect(UserControl.hDC, udtRect)
  387.         Else
  388.             UserControl.DrawWidth = 2
  389.             UserControl.Line (miClientLeft - 1, miClientTop - 1)-(miClientLeft + miClientWidth, miClientTop + miClientHeight), vb3DFace, B
  390.             UserControl.DrawWidth = 1
  391.         End If
  392.     End If
  393.  
  394.     'Draw the Picture
  395.     If Not picButton Is Nothing And (m_Style = [Cool Button] Or m_Style = [Toolbar Button] Or m_Style = [Standard Button] Or m_Style = [Up-Down Button]) Then
  396.         If UserControl.Enabled Then
  397.             'kdq 10/19/98 added GreyScaling for Coolbutton when mouse is not over it (user defined)
  398.             If m_Style = [Cool Button] And Not mbMouseOver And m_ShowFlatGrey Then
  399.                'clsPaint.PaintGreyScaleCornerStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
  400.                clsPaint.PaintGreyScaleStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
  401.             Else
  402.                clsPaint.PaintTransparentStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
  403.                'clsPaint.PaintNormalStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
  404.             End If
  405.         Else
  406.             clsPaint.PaintDisabledStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
  407.         End If
  408.     End If
  409.  
  410.     'Print the caption on the button
  411.     If m_Style = [Cool Button] Or m_Style = [Toolbar Button] Or m_Style = [Standard Button] Then
  412.         udtTextRect.Top = udtTextRect.Top + iDownOffset ' + (udtTextRect.Top Mod 2)
  413.         udtTextRect.Left = udtTextRect.Left + iDownOffset ' + (udtTextRect.Left Mod 2)
  414.         udtTextRect.Bottom = udtTextRect.Bottom + iDownOffset
  415.         udtTextRect.Right = udtTextRect.Right + iDownOffset
  416.         If UserControl.Enabled Then
  417.             lReturn = DrawText(UserControl.hDC, m_Caption, Len(m_Caption), udtTextRect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
  418.         Else
  419.             UserControl.ForeColor = vbGrayText
  420.             lReturn = DrawText(UserControl.hDC, m_Caption, Len(m_Caption), udtTextRect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
  421.             UserControl.ForeColor = vbButtonText
  422.         End If
  423.     End If
  424.     
  425.     Refresh
  426.     Set clsPaint = Nothing
  427.     Set picButton = Nothing
  428. End Sub
  429.  
  430. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  431. 'MappingInfo=UserControl,UserControl,-1,BackColor
  432. Public Property Get BackColor() As OLE_COLOR
  433. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  434. Attribute BackColor.VB_UserMemId = -501
  435.     BackColor = UserControl.BackColor
  436. End Property
  437.  
  438. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  439.     UserControl.BackColor() = New_BackColor
  440.     PropertyChanged "BackColor"
  441.     DrawButton
  442. End Property
  443.  
  444. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  445. 'MappingInfo=UserControl,UserControl,-1,ForeColor
  446. Public Property Get ForeColor() As OLE_COLOR
  447. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  448.     ForeColor = UserControl.ForeColor
  449. End Property
  450.  
  451. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  452.     UserControl.ForeColor() = New_ForeColor
  453.     PropertyChanged "ForeColor"
  454.     DrawButton
  455. End Property
  456.  
  457. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  458. 'MappingInfo=UserControl,UserControl,-1,Enabled
  459. Public Property Get Enabled() As Boolean
  460. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  461.     Enabled = UserControl.Enabled
  462. End Property
  463.  
  464. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  465.     UserControl.Enabled() = New_Enabled
  466.     PropertyChanged "Enabled"
  467.     DrawButton
  468. End Property
  469.  
  470. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  471. 'MappingInfo=UserControl,UserControl,-1,Font
  472. Public Property Get Font() As Font
  473. Attribute Font.VB_Description = "Returns a Font object."
  474. Attribute Font.VB_UserMemId = -512
  475.     Set Font = UserControl.Font
  476. End Property
  477.  
  478. Public Property Set Font(ByVal New_Font As Font)
  479.     Set UserControl.Font = New_Font
  480.     PropertyChanged "Font"
  481.     DrawButton
  482. End Property
  483.  
  484.  
  485. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  486. 'MappingInfo=UserControl,UserControl,-1,Refresh
  487. Public Sub Refresh()
  488. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  489.     UserControl.Refresh
  490. End Sub
  491.  
  492. Private Sub ExitTimer_Timer()
  493.     If Not UnderMouse Then Leave
  494. End Sub
  495.  
  496. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  497.     'kdq 10/19/98 only Click when control is a button
  498.     If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  499. End Sub
  500.  
  501. Private Sub UserControl_AmbientChanged(PropertyName As String)
  502.     If PropertyName = "DisplayAsDefault" Then
  503.         DrawButton
  504.     End If
  505.     
  506. End Sub
  507.  
  508. Private Sub UserControl_DblClick()
  509.     RaiseEvent DblClick
  510. End Sub
  511.  
  512. Private Sub UserControl_EnterFocus()
  513.     mbHasFocus = True
  514.     DrawButton
  515. End Sub
  516.  
  517. Private Sub UserControl_ExitFocus()
  518.     mbHasFocus = False
  519.     DrawButton
  520.     Refresh
  521. End Sub
  522.  
  523. Private Sub UserControl_Initialize()
  524. InitializeUpDownDither
  525. End Sub
  526.  
  527. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  528.     If KeyCode = 32 Then
  529.       miCurrentButtonPressed = 0
  530.       mbButtonDown = True
  531.       DrawButton
  532.     End If
  533.     RaiseEvent KeyDown(KeyCode, Shift)
  534. End Sub
  535.  
  536. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  537.     RaiseEvent KeyPress(KeyAscii)
  538. End Sub
  539.  
  540. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  541.     If KeyCode = 32 Then
  542.       miCurrentButtonPressed = -1
  543.       mbButtonDown = False
  544.       DrawButton
  545.       'kdq 10/19/98 only Click when control is a button
  546.        If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  547.     End If
  548.     RaiseEvent KeyUp(KeyCode, Shift)
  549. End Sub
  550.  
  551. Private Sub UserControl_LostFocus()
  552.     mbHasFocus = False
  553.     DrawButton
  554. End Sub
  555.  
  556. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  557.     If m_DropDown Then
  558.         If x > (UserControl.ScaleWidth - 11) Then
  559.             mbDropDownPressed = True
  560.             miCurrentButtonPressed = 1
  561.         Else
  562.             mbButtonDown = True
  563.             miCurrentButtonPressed = 0
  564.         End If
  565.     Else
  566.         mbButtonDown = True
  567.         miCurrentButtonPressed = 0
  568.     End If
  569.     mbMouseDown = True
  570.     DrawButton
  571.     RaiseEvent MouseDown(Button, Shift, x, y)
  572. End Sub
  573.  
  574. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  575.     If Button = 1 Then
  576.         If (x < 0 Or y < 0 Or x >= UserControl.ScaleWidth Or y >= UserControl.ScaleHeight) Then
  577.             If miCurrentButtonPressed = 0 Then
  578.                 mbButtonDown = False
  579.             Else
  580.                 mbDropDownPressed = False
  581.             End If
  582.             DrawButton
  583.         Else
  584.             If miCurrentButtonPressed = 0 Then
  585.                 mbButtonDown = True
  586.             Else
  587.                 mbDropDownPressed = True
  588.             End If
  589.             DrawButton
  590.         End If
  591.     End If
  592.     
  593.     If mbMouseOver Then
  594.         If Not UnderMouse Then
  595.             Leave
  596.         End If
  597.     Else
  598.         If UnderMouse Then
  599.             mbMouseOver = True
  600.             RaiseEvent MouseEnter
  601.             DrawButton
  602.             
  603.             'Set up the ExitTimer
  604.             Set ExitTimer = New objTimer
  605.             ExitTimer.Interval = 50
  606.             ExitTimer.Enabled = True
  607.         End If
  608.     End If
  609.     RaiseEvent MouseMove(Button, Shift, x, y)
  610. End Sub
  611.  
  612. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  613.     Dim bOverButton As Boolean
  614.     
  615.     RaiseEvent MouseUp(Button, Shift, x, y)
  616.     
  617.     'Check the position of the mouse when in was released.
  618.     'We only want to call the click events when the
  619.     'mouse was released over the button.
  620.     If (x < 0 Or y < 0 Or x >= UserControl.ScaleWidth Or y >= UserControl.ScaleHeight) Then
  621.         bOverButton = False
  622.     Else
  623.         bOverButton = True
  624.     End If
  625.     
  626.     If miCurrentButtonPressed = 1 Then
  627.         If bOverButton And x > (UserControl.ScaleWidth - 10) Then RaiseEvent DropDownClick
  628.     End If
  629.     mbButtonDown = False
  630.     mbDropDownPressed = False
  631.     mbMouseDown = False
  632.     
  633.     If m_Style = [Up-Down Button] Then
  634.         m_Value = Not m_Value
  635.         CheckButtonGroup
  636.     End If
  637.     
  638.     DrawButton
  639.     If miCurrentButtonPressed = 0 Then
  640.         If bOverButton And x < (UserControl.ScaleWidth - 10) And m_DropDown Then
  641.                 'kdq 10/19/98 only Click when control is a button
  642.                 If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  643.         'kdq 10/19/98 added this because click event wasnt firing for nondropdown buttons all the time
  644.         ElseIf bOverButton And Not m_DropDown Then
  645.                 'kdq 10/19/98 only Click when control is a button
  646.                 If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  647.         End If
  648.     End If
  649.     miCurrentButtonPressed = -1
  650.     DrawButton          ' added so flatbutton gets redrawn
  651. End Sub
  652.  
  653. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  654. 'MemberInfo=11,0,0,0
  655. Public Property Get Picture() As Picture
  656. Attribute Picture.VB_Description = "Image to be displayed on the button."
  657.     Set Picture = m_Picture
  658. End Property
  659.  
  660. Public Property Set Picture(ByVal New_Picture As Picture)
  661.     Set m_Picture = New_Picture
  662.     PropertyChanged "Picture"
  663.     DrawButton
  664. End Property
  665.  
  666. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  667. 'MemberInfo=7,0,0,0
  668. Public Property Get PictureAlign() As envbuPictureAlign
  669. Attribute PictureAlign.VB_Description = "Specifies alignment of the picture property."
  670.     PictureAlign = m_PictureAlign
  671. End Property
  672.  
  673. Public Property Let PictureAlign(ByVal New_PictureAlign As envbuPictureAlign)
  674.     m_PictureAlign = New_PictureAlign
  675.     PropertyChanged "PictureAlign"
  676.     DrawButton
  677. End Property
  678.  
  679. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  680. 'MemberInfo=13,0,0,
  681. Public Property Get Caption() As String
  682. Attribute Caption.VB_Description = "Text displayed on the face of the button."
  683. Attribute Caption.VB_UserMemId = -518
  684.     Caption = m_Caption
  685. End Property
  686.  
  687. Public Property Let Caption(ByVal New_Caption As String)
  688.     m_Caption = New_Caption
  689.     PropertyChanged "Caption"
  690.     SetAccessKey
  691.     DrawButton
  692. End Property
  693. Private Sub SetAccessKey()
  694.     Dim iPos As Integer
  695.     Dim sChar As String
  696.     
  697.     iPos = InStr(1, m_Caption, "&")
  698.     If iPos > 0 Then
  699.         sChar = Mid$(m_Caption, iPos + 1, 1)
  700.         If sChar <> "&" Then
  701.             UserControl.AccessKeys = LCase(sChar)
  702.         End If
  703.     End If
  704. End Sub
  705. 'Initialize Properties for User Control
  706. Private Sub UserControl_InitProperties()
  707.     Set UserControl.Font = Ambient.Font
  708.     Set m_Picture = LoadPicture("")
  709.     m_PictureAlign = m_def_PictureAlign
  710.     m_Caption = m_def_Caption
  711.     m_MaskColor = m_def_MaskColor
  712.     m_Style = m_def_Style
  713.     m_Value = False
  714.     m_DropDown = m_def_DropDown
  715.     m_ButtonFace = vbButtonFace
  716.     m_ButtonLightShadow = vbButtonShadow
  717.     m_ButtonDarkShadow = vb3DDKShadow
  718.     m_ButtonHighlight = vb3DHighlight
  719.     m_ShowFlatGrey = False
  720.     m_ButtonGroup = m_def_ButtonGroup
  721.     m_ButtonGroupDefault = m_def_ButtonGroupDefault
  722.     m_ButtonGroupDefault2 = m_def_ButtonGroupDefault2
  723.     
  724.     miCurrentButtonPressed = -1
  725.     mbMouseOver = False
  726.     mbButtonDown = False
  727.     mbMouseDown = False
  728.     mbHasFocus = False
  729.     mbDropDownPressed = False
  730.     End Sub
  731.  
  732. Private Sub UserControl_Paint()
  733.     DrawButton
  734. End Sub
  735.  
  736. 'Load property values from storage
  737. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  738.  
  739.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  740.     UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
  741.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  742.     Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
  743. '    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
  744. '    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
  745.     Set m_Picture = PropBag.ReadProperty("Picture", Nothing)
  746.     Set m_DownPicture = PropBag.ReadProperty("DownPicture", Nothing)
  747.     Set m_FlatPicture = PropBag.ReadProperty("FlatPicture", Nothing)
  748.     m_PictureAlign = PropBag.ReadProperty("PictureAlign", m_def_PictureAlign)
  749.     m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
  750.     m_MaskColor = PropBag.ReadProperty("MaskColor", &HC0C0C0)
  751.     m_Style = PropBag.ReadProperty("Style", m_def_Style)
  752.     m_DropDown = PropBag.ReadProperty("DropDown", m_def_DropDown)
  753.     m_ButtonDarkShadow = PropBag.ReadProperty("ColorDarkShadow", vb3DDKShadow)
  754.     m_ButtonLightShadow = PropBag.ReadProperty("ColorLightShadow", vbButtonShadow)
  755.     m_ButtonHighlight = PropBag.ReadProperty("ColorHighlight", vb3DHighlight)
  756.     m_ShowFlatGrey = PropBag.ReadProperty("ShowFlatGrey", False)
  757.     m_ButtonGroup = PropBag.ReadProperty("ButtonGroup", m_def_ButtonGroup)
  758.     m_ButtonGroupDefault = PropBag.ReadProperty("ButtonGroupDefault", m_def_ButtonGroupDefault)
  759.     m_ButtonGroupDefault2 = PropBag.ReadProperty("ButtonGroupDefault2", m_def_ButtonGroupDefault2)
  760.  
  761.     SetAccessKey
  762.     miCurrentButtonPressed = -1
  763.     DrawButton
  764. End Sub
  765.  
  766. Private Sub UserControl_Resize()
  767.     DrawButton
  768. End Sub
  769.  
  770. 'Write property values to storage
  771. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  772.  
  773.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
  774.     Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
  775.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  776.     Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
  777. '    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
  778. '    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
  779.     Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
  780.     Call PropBag.WriteProperty("DownPicture", m_DownPicture, Nothing)
  781.     Call PropBag.WriteProperty("FlatPicture", m_FlatPicture, Nothing)
  782.     Call PropBag.WriteProperty("PictureAlign", m_PictureAlign, m_def_PictureAlign)
  783.     Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
  784.     Call PropBag.WriteProperty("MaskColor", m_MaskColor, &HC0C0C0)
  785.     Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
  786.     Call PropBag.WriteProperty("DropDown", m_DropDown, m_def_DropDown)
  787.     Call PropBag.WriteProperty("ColorDarkShadow", m_ButtonDarkShadow, vb3DDKShadow)
  788.     Call PropBag.WriteProperty("ColorLightShadow", m_ButtonLightShadow, vbButtonShadow)
  789.     Call PropBag.WriteProperty("ColorHighlight", m_ButtonHighlight, vb3DHighlight)
  790.     Call PropBag.WriteProperty("ShowFlatGrey", m_ShowFlatGrey, False)
  791.     Call PropBag.WriteProperty("ButtonGroup", m_ButtonGroup, m_def_ButtonGroup)
  792.     Call PropBag.WriteProperty("ButtonGroupDefault", m_ButtonGroupDefault, m_def_ButtonGroupDefault)
  793.     Call PropBag.WriteProperty("ButtonGroupDefault2", m_ButtonGroupDefault2, m_def_ButtonGroupDefault2)
  794. End Sub
  795.  
  796. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  797. 'MemberInfo=10,0,0,0
  798. Public Property Get MaskColor() As OLE_COLOR
  799. Attribute MaskColor.VB_Description = "Sets/gets mask color to use when drawing picture"
  800.     MaskColor = m_MaskColor
  801. End Property
  802.  
  803. Public Property Let MaskColor(ByVal New_MaskColor As OLE_COLOR)
  804.     m_MaskColor = New_MaskColor
  805.     PropertyChanged "MaskColor"
  806.     DrawButton
  807. End Property
  808.  
  809. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  810. 'MemberInfo=7,0,0,0
  811. Public Property Get Style() As vbuStyle
  812. Attribute Style.VB_Description = "Gets/Sets the style of the button"
  813.     Style = m_Style
  814. End Property
  815.  
  816. Public Property Let Style(ByVal New_Style As vbuStyle)
  817.     m_Style = New_Style
  818.     PropertyChanged "Style"
  819.     DrawButton
  820. End Property
  821.  
  822. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  823. 'MemberInfo=0,0,0,False
  824. Public Property Get DropDown() As Boolean
  825. Attribute DropDown.VB_Description = "Determines whether or not to display the Drop Down Button."
  826.     DropDown = m_DropDown
  827. End Property
  828.  
  829. Public Property Let DropDown(ByVal New_DropDown As Boolean)
  830.     m_DropDown = New_DropDown
  831.     PropertyChanged "DropDown"
  832.     DrawButton
  833. End Property
  834.  
  835. 'kdq 10/19/98 added for seperator/handle
  836. Private Sub DrawVLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  837.     Line (x + 1, y)-(x + 1, y + cy), m_ButtonHighlight
  838.     Line (x, y)-(x, y + cy), m_ButtonLightShadow
  839. End Sub
  840.  
  841. 'kdq 11/03/98 added for seperator/handle
  842. Private Sub DrawHLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  843.     Line (x, y + 1)-(x + cx, y + 1), m_ButtonHighlight
  844.     Line (x, y)-(x + cx, y), m_ButtonLightShadow
  845. End Sub
  846.  
  847. 'kdq 10/19/98 added for seperator/handle
  848. Private Sub DrawRaisedVLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  849.     Line (x, y)-(x, y + cy), m_ButtonHighlight
  850.     Line (x + 1, y)-(x + 1, y + cy), m_ButtonHighlight
  851.     Line (x + 2, y)-(x + 2, y + cy), m_ButtonHighlight
  852.     Line (x, y + 1)-(x, y + cy), m_ButtonLightShadow
  853.     Line (x + 1, y + 1)-(x + 1, y + cy), m_ButtonLightShadow
  854.     Line (x + 2, y + 1)-(x + 2, y + cy), m_ButtonLightShadow
  855.     Line (x, y)-(x, y + cy - 1), m_ButtonHighlight
  856.     Line (x + 1, y + 1)-(x + 1, y + cy - 1), m_ButtonFace
  857. End Sub
  858.  
  859. 'kdq 11/03/98 added for seperator/handle
  860. Private Sub DrawRaisedHLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  861.     Line (x, y)-(x + cx, y), m_ButtonHighlight
  862.     Line (x, y + 1)-(x + cx, y + 1), m_ButtonHighlight
  863.     Line (x, y + 2)-(x + cx, y + 2), m_ButtonHighlight
  864.     Line (x + 1, y)-(x + cx, y), m_ButtonLightShadow
  865.     Line (x + 1, y + 1)-(x + cx, y + 1), m_ButtonLightShadow
  866.     Line (x + 1, y + 2)-(x + cx, y + 2), m_ButtonLightShadow
  867.     Line (x, y)-(x + cx - 1, y), m_ButtonHighlight
  868.     Line (x + 1, y + 1)-(x + cx - 1, y + 1), m_ButtonFace
  869. End Sub
  870.  
  871. 'kdq 10/19/98 added to make thinner border for CoolButton
  872. Private Sub DrawShadowBox(RectSize As RECT, ByVal Pressed As Boolean, ByVal DKShadow As Boolean)
  873.     Dim x As Integer, y As Integer, cx As Integer, cy As Integer
  874.     x = RectSize.Left
  875.     y = RectSize.Top
  876.     cx = RectSize.Right
  877.     cy = RectSize.Bottom
  878.     
  879.     If DKShadow Then
  880.         If Pressed Then
  881.             Line (x, y)-(x + cx - 1, y), m_ButtonDarkShadow
  882.             Line (x, y)-(x, y + cy - 1), m_ButtonDarkShadow
  883.             Line (x + 1, y + 1)-(x + cx - 2, y + 1), m_ButtonLightShadow
  884.             Line (x + 1, y + 1)-(x + 1, y + cy - 2), m_ButtonLightShadow
  885.             Line (x + cx - 1, y)-(x + cx - 1, y + cy), m_ButtonHighlight
  886.             Line (x, y + cy - 1)-(x + cx, y + cy - 1), m_ButtonHighlight
  887.         Else
  888.             Line (x, y)-(x + cx - 1, y), m_ButtonHighlight
  889.             Line (x, y)-(x, y + cy - 1), m_ButtonHighlight
  890.             Line (x + cx - 2, y + 1)-(x + cx - 2, y + cy - 1), m_ButtonLightShadow
  891.             Line (x + 1, y + cy - 2)-(x + cx - 1, y + cy - 2), m_ButtonLightShadow
  892.             Line (x + cx - 1, y)-(x + cx - 1, y + cy), m_ButtonDarkShadow
  893.             Line (x, y + cy - 1)-(x + cx, y + cy - 1), m_ButtonDarkShadow
  894.         End If
  895.     Else
  896.         Dim Color1 As Long
  897.         Dim Color2 As Long
  898.         If Pressed Then
  899.             Color1 = m_ButtonLightShadow
  900.             Color2 = m_ButtonHighlight
  901.         Else
  902.             Color1 = m_ButtonHighlight
  903.             Color2 = m_ButtonLightShadow
  904.         End If
  905.         Line (x, y)-(x + cx - 1, y), Color1
  906.         Line (x, y)-(x, y + cy - 1), Color1
  907.         Line (x + cx - 1, y)-(x + cx - 1, y + cy), Color2
  908.         Line (x, y + cy - 1)-(x + cx, y + cy - 1), Color2
  909.     End If
  910. End Sub
  911.  
  912. Public Property Get ColorLightShadow() As OLE_COLOR
  913. Attribute ColorLightShadow.VB_Description = "Sets/gets color of border light shadow"
  914.     ColorLightShadow = m_ButtonLightShadow
  915. End Property
  916.  
  917. Public Property Let ColorLightShadow(ByVal New_Value As OLE_COLOR)
  918.     If Not (m_ButtonLightShadow = New_Value) Then
  919.         m_ButtonLightShadow = New_Value
  920.         DrawButton
  921.     End If
  922.     PropertyChanged "ColorLightShadow"
  923. End Property
  924.  
  925. 'kdq 10/19/98
  926. Public Property Get ColorDarkShadow() As OLE_COLOR
  927. Attribute ColorDarkShadow.VB_Description = "Sets/gets color of border 3D dark shadow"
  928.     ColorDarkShadow = m_ButtonDarkShadow
  929. End Property
  930.  
  931. Public Property Let ColorDarkShadow(ByVal New_Value As OLE_COLOR)
  932.     If Not (m_ButtonDarkShadow = New_Value) Then
  933.         m_ButtonDarkShadow = New_Value
  934.         DrawButton
  935.     End If
  936.     PropertyChanged "ColorDarkShadow"
  937. End Property
  938.  
  939. 'kdq 10/19/98
  940. Public Property Get ColorHighlight() As OLE_COLOR
  941. Attribute ColorHighlight.VB_Description = "Sets/gets color of border 3D highlight"
  942.     ColorHighlight = m_ButtonHighlight
  943. End Property
  944.  
  945. Public Property Let ColorHighlight(ByVal New_Value As OLE_COLOR)
  946.     If Not (m_ButtonHighlight = New_Value) Then
  947.         m_ButtonHighlight = New_Value
  948.         DrawButton
  949.     End If
  950.     PropertyChanged "ColorHighlight"
  951. End Property
  952.  
  953. 'kdq 10/19/98
  954. Public Sub ShowAbout()
  955. Attribute ShowAbout.VB_Description = "Show about box"
  956. Attribute ShowAbout.VB_UserMemId = -552
  957.     frmAbout.Show vbModal
  958. End Sub
  959.  
  960. 'kdq 10/19/98 picture to display when mousedown on cool button
  961. Public Property Get DownPicture() As Picture
  962. Attribute DownPicture.VB_Description = "Sets/gets picture to be displayed if button is pushed"
  963.     Set DownPicture = m_DownPicture
  964. End Property
  965.  
  966. Public Property Set DownPicture(ByVal New_DownPicture As Picture)
  967.     Set m_DownPicture = New_DownPicture
  968.     PropertyChanged "DownPicture"
  969. End Property
  970.  
  971. 'kdq 10/19/98 picture to display when mouse is not over button on cool button
  972. Public Property Get FlatPicture() As Picture
  973. Attribute FlatPicture.VB_Description = "Sets/gets picture to display when mouse is not over button (Cool button only)"
  974.     Set FlatPicture = m_FlatPicture
  975. End Property
  976.  
  977. Public Property Set FlatPicture(ByVal New_FlatPicture As Picture)
  978.     Set m_FlatPicture = New_FlatPicture
  979.     DrawButton
  980.     PropertyChanged "FlatPicture"
  981. End Property
  982.  
  983. 'kdq 10/19/98 display picture as greyscale when mouse is not over Cool Button
  984. Public Property Get ShowFlatGrey() As Boolean
  985. Attribute ShowFlatGrey.VB_Description = "Sets/gets a value to determine if picture is drawn in greyscale when mouse is not over button"
  986.     ShowFlatGrey = m_ShowFlatGrey
  987. End Property
  988.  
  989. Public Property Let ShowFlatGrey(ByVal New_Value As Boolean)
  990.     m_ShowFlatGrey = New_Value
  991.     PropertyChanged "DropDown"
  992.     DrawButton
  993. End Property
  994.  
  995. Public Property Get ButtonGroup() As String
  996.     ButtonGroup = m_ButtonGroup
  997. End Property
  998.  
  999. Public Property Let ButtonGroup(ByVal New_ButtonGroup As String)
  1000.     If Not (m_ButtonGroup = New_ButtonGroup) Then
  1001.         m_ButtonGroup = New_ButtonGroup
  1002.         If m_Style = [Up-Down Button] Then
  1003.             CheckButtonGroup
  1004.             Cls
  1005.             UserControl_Paint
  1006.         End If
  1007.     End If
  1008.     PropertyChanged "ButtonGroup"
  1009. End Property
  1010.  
  1011. Public Property Get ButtonGroupDefault() As Boolean
  1012.     ButtonGroupDefault = m_ButtonGroupDefault
  1013. End Property
  1014.  
  1015. Public Property Let ButtonGroupDefault(ByVal New_ButtonGroupDefault As Boolean)
  1016.     'The following line of code ensures that the integer
  1017.     'value of the boolean parameter is either
  1018.     '0 or -1.  It is known that Access 97 will
  1019.     'set the boolean's value to 255 for true.
  1020.     'In this case a P-Code compiled VB5 built
  1021.     'OCX will return True for the expression
  1022.     '(Not [boolean variable that ='s 255]).  This
  1023.     'line ensures the reliability of boolean operations
  1024.     If CBool(New_ButtonGroupDefault) Then New_ButtonGroupDefault = True Else New_ButtonGroupDefault = False
  1025.     If Not (m_ButtonGroupDefault = New_ButtonGroupDefault) Then
  1026.         m_ButtonGroupDefault = New_ButtonGroupDefault
  1027.         If m_Style = [Up-Down Button] Then
  1028.             CheckButtonGroupDefault
  1029.             CheckButtonGroup
  1030.             Cls
  1031.             UserControl_Paint
  1032.         End If
  1033.     End If
  1034.     PropertyChanged "ButtonGroupDefault"
  1035. End Property
  1036.  
  1037. Private Sub CheckButtonGroupDefault()
  1038.     If (Len(m_ButtonGroup) > 0) Then
  1039.         If m_ButtonGroupDefault Then     ' make all others in group not default
  1040.             Dim ctl As Control
  1041.             Dim i As Long
  1042.             For i = 0 To UserControl.ParentControls.Count - 1
  1043.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1044.                     Set ctl = UserControl.ParentControls(i)
  1045.                     If TypeOf ctl Is axPickerButton Then
  1046.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1047.                             If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1048.                                 ctl.ButtonGroupDefault = False
  1049.                             End If
  1050.                         End If
  1051.                     End If
  1052.                 End If
  1053.             Next
  1054.         End If
  1055.     End If
  1056. End Sub
  1057.  
  1058. Public Property Get ButtonGroupDefault2() As Boolean
  1059.     ButtonGroupDefault2 = m_ButtonGroupDefault2
  1060. End Property
  1061.  
  1062. Public Property Let ButtonGroupDefault2(ByVal New_ButtonGroupDefault2 As Boolean)
  1063.     'The following line of code ensures that the integer
  1064.     'value of the boolean parameter is either
  1065.     '0 or -1.  It is known that Access 97 will
  1066.     'set the boolean's value to 255 for true.
  1067.     'In this case a P-Code compiled VB5 built
  1068.     'OCX will return True for the expression
  1069.     '(Not [boolean variable that ='s 255]).  This
  1070.     'line ensures the reliability of boolean operations
  1071.     If CBool(New_ButtonGroupDefault2) Then New_ButtonGroupDefault2 = True Else New_ButtonGroupDefault2 = False
  1072.     If Not (m_ButtonGroupDefault2 = New_ButtonGroupDefault2) Then
  1073.         m_ButtonGroupDefault2 = New_ButtonGroupDefault2
  1074.         If m_Style = [Up-Down Button] Then
  1075.             CheckButtonGroupDefault2
  1076.             CheckButtonGroup
  1077.             Cls
  1078.             UserControl_Paint
  1079.         End If
  1080.     End If
  1081.     PropertyChanged "ButtonGroupDefault2"
  1082. End Property
  1083.  
  1084. Private Sub CheckButtonGroupDefault2()
  1085.     If (Len(m_ButtonGroup) > 0) Then
  1086.         If m_ButtonGroupDefault2 Then     ' make all others in group not default
  1087.             Dim ctl As Control
  1088.             Dim i As Long
  1089.             For i = 0 To UserControl.ParentControls.Count - 1
  1090.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1091.                     Set ctl = UserControl.ParentControls(i)
  1092.                     If TypeOf ctl Is axPickerButton Then
  1093.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1094.                             If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1095.                                 ctl.ButtonGroupDefault2 = False
  1096.                             End If
  1097.                         End If
  1098.                     End If
  1099.                 End If
  1100.             Next
  1101.         End If
  1102.     End If
  1103. End Sub
  1104.  
  1105. Private Sub CheckButtonGroup()
  1106.     If (Len(m_ButtonGroup) > 0) Then
  1107.         Dim ctl As Control
  1108.         Dim i As Long
  1109.         If m_Value Then     ' clear all others in group
  1110.             For i = 0 To UserControl.ParentControls.Count - 1
  1111.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1112.                     Set ctl = UserControl.ParentControls(i)
  1113.                     If TypeOf ctl Is axPickerButton Then
  1114.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1115.                             If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1116.                                 ctl.Value = False
  1117.                             End If
  1118.                         End If
  1119.                     End If
  1120.                 End If
  1121.             Next
  1122.         Else                 ' set group default if necessary
  1123.             Dim GroupValueSet As Boolean
  1124.             Dim ctlDefault As axPickerButton
  1125.             Dim ctlDefault2 As axPickerButton
  1126.             Set ctlDefault = Nothing
  1127.             Set ctlDefault2 = Nothing
  1128.             GroupValueSet = False
  1129.             For i = 0 To UserControl.ParentControls.Count - 1
  1130.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1131.                     Set ctl = UserControl.ParentControls(i)
  1132.                     If TypeOf ctl Is axPickerButton Then
  1133.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1134. '                            If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1135.                                 If ctl.Value Then
  1136.                                     GroupValueSet = True
  1137.                                     Exit For
  1138.                                 ElseIf ctl.ButtonGroupDefault Then
  1139.                                     Set ctlDefault = ctl
  1140.                                 ElseIf ctl.ButtonGroupDefault2 Then
  1141.                                     Set ctlDefault2 = ctl
  1142.                                 End If
  1143. '                            End If
  1144.                         End If
  1145.                     End If
  1146.                 End If
  1147.             Next
  1148.             If Not (GroupValueSet Or (ctlDefault Is Nothing)) Then
  1149.                 If (Not m_ButtonGroupDefault) Or (ctlDefault2 Is Nothing) Then
  1150.                     ctlDefault.Value = True
  1151.                 Else
  1152.                     ctlDefault2.Value = True
  1153.                 End If
  1154.             End If
  1155.         End If
  1156.     End If
  1157. End Sub
  1158.  
  1159. Public Property Get Value() As Boolean
  1160.     Value = m_Value
  1161. End Property
  1162.  
  1163. Public Property Let Value(ByVal New_Value As Boolean)
  1164.     'The following line of code ensures that the integer
  1165.     'value of the boolean parameter is either
  1166.     '0 or -1.  It is known that Access 97 will
  1167.     'set the boolean's value to 255 for true.
  1168.     'In this case a P-Code compiled VB5 built
  1169.     'OCX will return True for the expression
  1170.     '(Not [boolean variable that ='s 255]).  This
  1171.     'line ensures the reliability of boolean operations
  1172.     If CBool(New_Value) Then New_Value = True Else New_Value = False
  1173.     If Not (m_Value = New_Value) Then
  1174.         m_Value = New_Value
  1175.         If m_Style = [Up-Down Button] Then
  1176.             CheckButtonGroup
  1177.             Cls
  1178.             UserControl_Paint
  1179.         End If
  1180.     End If
  1181.     PropertyChanged "Value"
  1182. End Property
  1183.  
  1184. Private Sub PaintUpDownDither(x As Long, y As Long, Width As Long, Height As Long)
  1185.     Dim ret As Long
  1186.     Dim MyRect As RECT
  1187.     'draw on the form with that brush
  1188.     MyRect.Left = x
  1189.     MyRect.Top = y
  1190.     MyRect.Right = x + Width
  1191.     MyRect.Bottom = y + Height
  1192.     ret = FillRect(UserControl.hDC, MyRect, hUpDownDitherBrush)
  1193. End Sub
  1194.  
  1195. Private Sub InitializeUpDownDither()
  1196.     Dim i As Long, j As Long
  1197.     
  1198.     '---one-time setup: put this in it's own routine------
  1199.     'set (invisible) picturebox properties for creating a brush
  1200. '    UserControl.ScaleMode = vbPixels
  1201. '    UserControl.AutoRedraw = True
  1202.     'draw the dither in it
  1203.     For i = 0 To UserControl.ScaleWidth - 1
  1204.         For j = 0 To UserControl.ScaleHeight - 1
  1205.             If (i + j) Mod 2 Then
  1206.                 UserControl.PSet (i, j), vb3DHighlight
  1207.             Else
  1208.                 UserControl.PSet (i, j), vbButtonFace
  1209.             End If
  1210.         Next j
  1211.     Next i
  1212.     '---end of one-time setup------
  1213.  
  1214.     'create the brush from it
  1215.     hUpDownDitherBrush = CreatePatternBrush(UserControl.Image.handle)
  1216.  
  1217. End Sub
  1218.  
  1219.